Zbadać częstotliwość oraz skalę opóźnień pociągów w danym okresie oraz zależność ich od sytuacji meteorologicznej. Przedstawić tę zależność za pomocą wizualizacji.
Przed badaniem robimy przypuszczenie, iż gorsza sytuacja pogodowa powoduje większe i częstsze opóźnienia
Opis: The dataset contains information about delays on polish railroads published by the Polish State Railways in real time. Data was scraped from https://infopasazer.intercity.pl. It covers the period from the midnight of 2022-05-16 until the midnight of 2022-05-30. Observations were collected every 5 minutes.
Zmienne:
datetime - timestamp at which the sample was collected (Warsaw time)
id - train ID
carrier - the name of the carrier (mainly its PKP Intercity)
date - date of the train departure
connection - beginning and the destination for the train
arrival - planned arrival time at the destination
delay - current estimated delay
name - train station name
Dataset został opublikowany w roku 2022 i do teraz ma nie więcej niż 800 pobrań. Nie znalazłem również żadnych raportów z wykorzystaniem tego zbioru, więc można stwierdzić, że zbiór jest dość unikatowy.
Z drugiej strony, zbiór liczy około 4 mln obserwacji, więc jest dla nas dość reprezentatywny.
Opis: Są to archiwowe dane pogodowe dla okresu, odpowiadającego okresu zbierania danych w pierwszym zbiorze. Za lokalizaję wzięto przybliżone koordynaty geograficznego centrum Polski.
W tym projekcie po czyszczeniu zbioru danych oraz konwertowaniu poszczególnych zmiennych do właściwego dla nas typu zajmiemy się badaniem zależności pomiędzy pewnymi typami zmiennych za pomocą np. wyznaczenia korelacji pomiędzy zmiennymi numerycznymi. Znajdziemy też średnie opóźnień dla poszczególnych przewoźników lub relacji, uwzględnimy dane pogodowe, żeby wyłapać tę zależność oraz wesprzymy nasze wnioski odpowiednimi wizualicjami. Pomysłem też jest zrobienie liniowego modelu predykcyjnego, który na podstawie danych pogodowych będzie przewidywał średnie opóźnienie na poszczególnych stacji.
Z powodu tego, że zbiór 1 liczy prawie 4 mln
obserwacji, czyszczenie, modyfikowanie obu zbiorów, wybranie prób
reprezentatywnych oraz łączenie w jedyny zbiór zostało umieszczone w
oddzielnym pliku delays_modification.qmd oraz zrenderowane
do tego pliku, w celu
oszczędzania zasobów komputera podczas przeprowadzania analizy.
rm(list = ls())
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(chron)
##
## Attaching package: 'chron'
##
## The following objects are masked from 'package:lubridate':
##
## days, hours, minutes, seconds, years
library(corrplot)
## corrplot 0.95 loaded
df = read.csv("data.csv")
library(ggridges)
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
delay_summary = df %>%
group_by(carrier, delay_factor) %>%
summarise(count = log(n()), .groups = 'drop')
total_counts = delay_summary %>%
group_by(carrier) %>%
summarise(total_count = sum(count), .groups = 'drop')
delay_summary = delay_summary %>%
left_join(total_counts, by = "carrier") %>%
mutate(count = 100*count / total_count)
bar_plot = ggplot(delay_summary, aes(x = carrier, y = count, fill = delay_factor)) +
geom_bar(stat = "identity", position = "dodge") +
labs(
title = "Counts of Train Delays by Carrier",
#x = "Carrier",
y = "Log(Percentage of delay type)",
fill = "Delay Factor"
) +
theme_minimal(base_size = 15) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(face = "bold"),
legend.position = "right"
)
interactive_plot = ggplotly(bar_plot)
interactive_plot = interactive_plot %>%
layout(
xaxis = list(tickangle = 45)
)
interactive_plot